PlotFest: Parametric Plotting in 2D

Needs["LinearAlgebra`MatrixManipulation`"]
Needs["Graphics`Colors`"]
Needs["Geometry`Rotations`"]
Off[General::spell];
Off[General::spell1];
Off[ParametricPlot3D::ppcom];
Off[ParametricPlot::ppcom];
Off[Plot::plnr];
SetOptions[Limit,Analytic->True];
$Pre = Chop;

CMView = {2.7, 1.6, 1.2};

Vector Drawer

(* :Title:  NewVectorDraw  *)
(* :Author: Bruce Carpenter *)
(* :Summary:  Construct 2 and 3 dimensional vectors,
     arrows, and arrowheads as graphics 
     objects.
*)
(* :Date:  Copyright 1997, Math Everywhere, Inc. 
*)
(*  :Drawbacks:  Since the vectors are drawn out of 
     context, the shapes of the arrowheads are only 
     correct with AspectRatio set to Automatic.
*)
Unprotect[Axes3D, Perpend, Norm, Normalize, Vector, Arrow, ArrowHead, Tail, VectorColor, HeadSize, HeadRatio, TipSize, TipRatio, Aperture, ZeroVectorPointSize, ScaleFactor];
Remove[Blue, Red, Green, Axes3D, Perpend, Norm, Normalize, Vector, Arrow, ArrowHead, Tail, VectorColor, HeadSize, HeadRatio, TipSize, TipRatio, Aperture, ZeroVectorPointSize, ScaleFactor];
<<"Graphics`Colors`";
BeginPackage["Vector3D`","Graphics`Colors`"];
Unprotect[Axes3D, Perpend, Norm, Normalize, Vector, Arrow, ArrowHead]; 
Axes3D::usage = "Axes3D[a, b] creates a Graphics3D object of cartesian axes with x, y, and z running from -a/3 to a, and with axes labels b units beyond the tips of the axes.  Axes3D[a] is Axes3D[a, a/8].";
Perpend::usage = "Perpend[a] returns a unit vector which is perpendicular to the vector a.";
Arrow::usage = "Arrow[a] produces a 2 or 3 dimensional vector from the origin to a. Arrow[a, Tail -> tail] gives a vector from tail to a.";
Vector::usage = "Vector[a, b] gives a 2D or 3D vector from a to b.";
ArrowHead::usage = "ArrowHead[a, vec] produces an arrowhead with its tip placed at the point a, pointing in the direction of the vector vec.";
Tail::usage = "Tail -> point puts the tail of the vector at point.";
Norm::usage = "Norm[vec] returns the Euclidean length of vec.";
Normalize::usage = "Normalize[vec] returns a unit vector in the direction of vec, provided vec is nonzero.";
Aperture::usage = "Aperture is the ratio of the radius of the base to the length of the head of a vector.";
TipSize::usage = "TipSize specifies an absolute size for the inner tip length of the head of a vector.";
TipRatio::usage = "TipRatio is the ratio of the inner length of the arrowhead to the length of the shaft of a vector.";
HeadRatio::usage = "HeadRatio is the ratio of the outer length of the arrowhead to the length of the shaft of a vector.";
HeadSize::usage = "HeadSize specifies an absolute size for the head of a vector.";
ScaleFactor::usage = "ScaleFactor specifies the amount to scale a vector in length and may be either a number or a pure function.";
ZeroVectorPointSize::usage = "ZeroVectorPointSize is the size of the point used to represent a zero vector.";
Options[Vector] = Options[Arrow] = Options[ArrowHead] =
{HeadRatio -> 0.18, TipRatio -> 0.14, Aperture -> 0.3, ScaleFactor -> 1, HeadType -> Polygon, ShaftQ -> True, EdgesQ -> True, VectorColor -> RGBColor[0,0,1], ShaftWidth -> 0.005, ZeroVectorPointSize -> 0.01};

Begin["`Private`"];
SetOptions[ParametricPlot,AspectRatio -> Automatic];
SetOptions[Plot,AspectRatio -> Automatic];
SetOptions[Graphics,AspectRatio -> Automatic];
Axes3D[u_,v_] := Graphics3D[{ {Blue,Line[{{-u/3,0,0},{u,0,0}}]},
    Text["x",{u + v,0,0}], {Blue,Line[{{0,-u/3,0},{0,u,0}}]},
    Text["y",{0, u + v,0}], {Blue,Line[{{0,0,-u/3},{0,0,u}}]},
    Text["z",{0,0,u + v}]}]; 
Axes3D[u_] := Axes3D[u,u/8];
Norm[a_?VectorQ] := N[Sqrt[a.a]];
Normalize[a_?VectorQ] := If[a.a == 0, a, a/Norm[a]];
Perpend[a_?VectorQ] := Normalize[{a[[2]],-a[[1]]}]/;Length[a]==2
Perpend[a_?VectorQ] := Normalize[If[a[[1]]==0,{1,0,0},{0,a[[3]],-a[[2]]}]]/;Length[a]==3
Base3D = Table[{Cos[2 k Pi/8.], Sin[2 k Pi/8.]},{k,0,8}]; 
Vector[from_?VectorQ, to_?VectorQ, opts___] := Module[
   {sq, sw, ht, hs, hr, tr, ap, sf, vc, zvps, diff = to - from, tip},
   {sq, sw, ht, hs, hr, ts, tr, ap, sf, vc, zvps} = {ShaftQ, ShaftWidth, HeadType, HeadSize, HeadRatio, TipSize, TipRatio, Aperture, ScaleFactor, VectorColor, ZeroVectorPointSize} /. {opts} /. Options[Vector];
   If[from==to, Return[Graphics[{PointSize[zvps],vc,Point[from]}]]];
   diff = If[NumberQ[N[sf]], sf diff, sf[diff]];
   tip = from + diff;
   If[NumberQ[hs], hr = hs/Norm[diff]; tr = 0.75 hr];
   If[NumberQ[ts], tr = ts/Norm[diff]];
   Graphics[{If[sq,{vc,Thickness[sw],Line[{from,tip - tr diff}]},{}],With[{trans = ap hr Norm[diff] Perpend[diff]},
      {vc, Thickness[sw], ht[{tip, (tip - hr diff + trans),
       (tip - tr diff), (tip - hr diff - trans),tip}]}]}]
] /; Length[from]==Length[to]==2
Vector[from_?VectorQ, to_?VectorQ, opts___] := Module[
   {sq, eq, sw, hs, hr, tr,ap, sf, vc, zvps, diff = to - from, tip},
   {sq, eq, sw, hs, hr, ap, sf, vc, zvps} = {ShaftQ, EdgesQ, ShaftWidth, HeadSize, HeadRatio, Aperture, ScaleFactor, VectorColor, ZeroVectorPointSize} /. {opts} /. Options[Vector];
   If[from==to, Return[Graphics3D[{PointSize[zvps],vc,Point[from]}]]];
   diff = If[NumberQ[N[sf]], sf diff, sf[diff]];
   tip = from + diff;
   If[NumberQ[hs], hr = hs/Norm[diff]];
   tr = hr/2;
   Graphics3D[{If[sq,{vc,Thickness[sw],Line[{from,tip-tr diff}]},{}], If[eq, {}, EdgeForm[]], {SurfaceColor[vc],
      With[{temp = Perpend[diff]},
      Polygon[Append[#,tip]]& /@ Partition[(tip - hr diff + #)&/@((ap hr Norm[diff] Base3D) . {temp,Normalize[Cross[temp,diff]]}),2,1]]}}]
] /; Length[from]==Length[to]==3
Arrow[a_, Tail->b_, opts___] := Vector[b,a+b,opts]
Arrow[a_, opts___] := Vector[Table[0,{Length[a]}],a,opts]
ArrowHead[a_, b_, opts___] := Vector[a-b,a,ShaftQ->False,opts]
Protect[Axes3D, Perpend, Norm, Normalize, Vector, Arrow, ArrowHead]; 
End[];
EndPackage[];
Null

The ParametricPlot instruction for plotting lines circles, ellipses, etc.

Plot a line through {0,0}

To plot a line, you need a direction vector for the line. Here's one:

directionvector  =  {2.2, 0.9};
directionplot  = 
        Show[Arrow[directionvector, Tail -> {0, 0}, VectorColor -> Blue], 
          PlotRange -> {{-3, 3}, {-3, 3}}, Axes -> True, 
          AxesLabel -> {"x", "y"}];

The line through {0,0} determined by this direction vector is:

Clear[line, t]
\(	line[t_]\  = \ t\ directionvector\)
lineplot  =  
        ParametricPlot[line[t], {t, -3, 3},  
          PlotStyle -> {{Thickness[0.01], CadmiumOrange}}, 
          DisplayFunction -> Identity];
Show[directionplot, lineplot, 
        DisplayFunction -> $DisplayFunction];

Select both all the plots immediately above and then go to the Cell menu and select :  Animate Selected Graphics.

Plot a circle:

Here's how you plot the circle of radius 2 centered at {0,0}:

radius  =  2;
Clear[x, y, t]
{x[t_], y[t_]}  =  radius {Cos[t], Sin[t]}
{tlow, thigh}  =  {0,  2 Pi};
circleplot  =  
        ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
          PlotStyle -> {{Thickness[0.01], Red}}, 
          AxesLabel -> {"x", "y"}];

See {x[t],y[t]} = 2 {Cos[t], Sin[t]} dance around the circle as t runs from 0 to 2 π.

Clear[circlepoint, label]
circlepoint[t_]  :=  
        Graphics[{Blue, PointSize[0.05], Point[{x[t], y[t]}]}];
label[t_]  :=  
        Graphics[Text[t  , 0.4  radius {1, 1}]];
tjump  =  Pi/3;
ranger  =  radius  +  0.3;
Table[
      Show[circleplot, circlepoint[t], label[t]], {t, tlow, thigh, 
        tjump}]

To see a movie of {x[t],y[t]} = 2 {Cos[t], Sin[t]} dancing along the curve,
-> select all the plots immediately above and then 
-> go to the Cell menu and select :  Animate Selected Graphics.
Control the speed by pressing numbers at the top of the keyboard

Plot a an ellipse centered at {0.0}:

Here's how you plot  the ellipse centered at {0,0} with long axis 4 along the x-axis and short axis 1.3 along the y-axis.

long  =  4/2;
short  =  1.3/2;
Clear[x, y, t]
{x[t_], y[t_]}  =  {long Cos[t], short Sin[t]}
{tlow, thigh}  =  {0,  2 Pi};
ellipseplot  =  
        ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
          PlotStyle -> {{Thickness[0.01], DarkGreen}}, 
          AxesLabel -> {"x", "y"}];

See {x[t],y[t]} = {long Cos[t],short Sin[t]}; dance around the ellipse as t runs from 0 to 2 π.

Clear[ellipsepoint, label]
ellipsepoint[t_]  :=  
        Graphics[{Blue, PointSize[0.03], Point[{x[t], y[t]}]}];
label[t_]  :=  
        Graphics[Text[t  , 0.4  short {1, 1}]];
\(\(tjump\  = \ Pi/3;\)
\)
Table[
      Show[ellipseplot, ellipsepoint[t], label[t]], {t, tlow, thigh, 
        tjump}]

To see a movie of {x[t],y[t]} = {long Cos[t], short Sin[t]} dancing along the curve,
-> select all the plots immediately above and then 
-> go to the Cell menu and select :  Animate Selected Graphics.

Plot a tilted ellipse centered at {0,0}

To plot a tilted ellipse, you need a perpendicular frame to hang the ellipse on:
Here's a look at one:

s = Pi/8;
Clear[perpframe];
{perpframe[1],perpframe[2]} = 
{{Cos[s],Sin[s]},{-Sin[s],Cos[s]}};

perpframeplot =Show[Table[
     Arrow[perpframe[k],Tail->{0,0},VectorColor->Red,HeadSize->0.2],{k,1,2}], 
     Graphics[Text["perpframe[1]",0.6 perpframe[1]]],
     Graphics[Text["perpframe[2]",0.6 perpframe[2]]],
     Axes->True,AxesLabel->{"x","y"},PlotLabel->"Perp Frame"];

Here's how you plot  the ellipse centered at {0,0} with long axis 2.8 along the perpframe[1] and short axis 1.6 along the perpframe[2].

long  =  2.8/2;
short  =  1.6/2;
Clear[x, y, t]
{x[t_], y[t_]}  =  
      long Cos[t] perpframe[1]  +  short Sin[t] perpframe[2]
{tlow, thigh}  =  {0,  2 Pi};
ellipseplot  =  
        ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
          PlotStyle -> {{Thickness[0.01], Blue}}, 
          AxesLabel -> {"x", "y"}];

See the ellipse plot together with the perpendicular frame:

Show[ellipseplot, perpframeplot]

Use different perpframes to see this ellipse whirl around {0,0}:

long = 2.8/2;
short = 1.6/2;
Clear[s]
Clear[perpframe,perpframeplot];
{perpframe[1],perpframe[2]} = 
{{Cos[s],Sin[s]},{-Sin[s],Cos[s]}};

perpframeplot[s_] :=Show[Table[
     Arrow[perpframe[k],Tail->{0,0},VectorColor->Red,HeadSize->0.2],{k,1,2}], 
     Graphics[Text["perpframe[1]",0.6 perpframe[1]]],
     Graphics[Text["perpframe[2]",0.6 perpframe[2]]],
     Axes->True,AxesLabel->{"x","y"},PlotLabel->"Perp Frame",DisplayFunction->Identity];

Clear[x,y,t,ellipseplot]
{x[t_],y[t_]} = long Cos[t] perpframe[1] + short Sin[t] perpframe[2];
{tlow,thigh} = {0, 2 Pi};
ellipseplot[s_] := 
  ParametricPlot[{x[t],y[t]},{t,tlow,thigh},
    PlotStyle->{{Thickness[0.01],Blue}},AxesLabel->{"x","y"},
    DisplayFunction->Identity];
Table[Show[ellipseplot[t],perpframeplot[s],PlotRange->{{-long,long},{-long,long}},DisplayFunction->$DisplayFunction],{s,0, 2 Pi,Pi/4}]

To see a movie of the ellipse whirling about {0,0},
-> select all the plots immediately above and then 
-> go to the Cell menu and select :  Animate Selected Graphics.

Plot some  more curves with Sines and Cosines

Here's what you get when you plot 
	{x[t], y[t]} = {t - Sin[2 t], 6 Cos[t]^2}:

\(\(\(
\)\(Clear[x, y, t]

    {x[t_], y[t_]}\  = \ {t\  - \ Sin[2\ t], \ 6\ Cos[t]^2}

    \({tlow, thigh}\  = \ {0, \ 8};\)

    \ \(ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
        PlotStyle -> {{Thickness[0.01], HotPink}}, 
        AxesLabel -> {"x", "y"}];\)\)\)\)

Here's what you get when you plot 
	{x[t], y[t]} =  t {Cos[5  t], Sin[5 t]} :

\(\(\(
\)\(Clear[x, y, t]

    {x[t_], 
        y[t_]}\  = \ \(\(t\)\(\ \)\({\ Cos[5  t], \ \ Sin[5\ t]}\)\(\ \)\)

    \({tlow, thigh}\  = \ {0, \ 8};\)

    \ \(ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
        PlotStyle -> {{Thickness[0.01], Red}}, 
        AxesLabel -> {"x", "y"}];\)\)\)\)

Here's what you get when you plot 
	{x[t], 
          y[t]} =  (E^(-0.3 t)) {Cos[5  t], 
            Sin[5 t]} :

\(\(\(
\)\(Clear[x, y, t]

    {x[t_], 
        y[t_]}\  = \ \(\(E^\((\(-0.3\)\ t)\)\)\(\ \)\({\ 
          Cos[5  t], \ \ Sin[5\ t]}\)\(\ \)\)

    \({tlow, thigh}\  = \ {0, 16};\)

    \ \(ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, PlotRange -> All, 
        PlotStyle -> {{Thickness[0.01], Red}}, 
        AxesLabel -> {"x", "y"}];\)\)\)\)

Here's what you get when you plot 
	{x[t], y[t]} = {Cos[t] Sin[3 t],  Sin[t] Sin[3 t]}:

\(\(\(
\)\(Clear[x, y, t]

    {x[t_], y[t_]}\  = \ {Cos[t]\ Sin[3\ t], \ Sin[t]\ Sin[3\ t]}

    \({tlow, thigh}\  = \ {0, \ 2\ Pi};\)

    \(ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
        PlotStyle -> {{Thickness[0.01], Firebrick}}, 
        AxesLabel -> {"x", "y"}];\)\)\)\)

Here's what you get when you plot 
	{x[t], y[t]} = {Cos[t] Sin[4 t],  Sin[t] Sin[4  t]}:

\(\(\(
\)\(Clear[x, y, t]

    {x[t_], y[t_]}\  = \ {Cos[t]\ Sin[4\ t], \ Sin[t]\ Sin[4\ t]}

    \({tlow, thigh}\  = \ {0, \ 2\ Pi};\)

    \(ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
        PlotStyle -> {{Thickness[0.01], DarkTurquoise}}, 
        AxesLabel -> {"x", "y"}];\)\)\)\)

Here's what you get when you plot 
	{x[t], y[t]} = {t  -  Sin[3 t],  5 Sin[t] Sin[1.5 t]}:

\(\(\(
\)\(Clear[x, y, t]

    {x[t_], y[t_]}\  = \ {t\  - \ Sin[3\ t], \ 5\ Sin[t]\ Sin[1.5\ t]}

    \({tlow, thigh}\  = \ {0, \ 2\ Pi};\)

    \ \(ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
        PlotStyle -> {{Thickness[0.01], Magenta}}, 
        AxesLabel -> {"x", "y"}];\)\)\)\)

Increase the plotting interval:

Clear[x, y, t]
{x[t_], y[t_]}  =  {t  -  Sin[3 t],  
            5 Sin[t] Sin[1.5 t]}
{tlow, thigh} = {0, 6 Pi};
 ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
            PlotStyle -> {{Thickness[0.01], Magenta}}, 
            AxesLabel -> {"x", "y"}];

Here's what you get when you plot 
	{x[t], y[t]} = 
         {Cos[t] ( 1  -  Cos[t]),  Sin[t] ( 1  -  Cos[t])}
          :

\(\(\(
\)\(Clear[x, y, t]

    {x[t_], y[t_]}\  = \ {Cos[t]\ \((\ 1\  - \ Cos[t])\), \ 
        Sin[t]\ \((\ 1\  - \ Cos[t])\)}

    \({tlow, thigh}\  = \ {0, \ 2\ Pi};\)

    \(ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
        PlotStyle -> {{Thickness[0.01], Red}}, 
        AxesLabel -> {"x", "y"}];\)\)\)\)

Here's what you get when you plot 
	{x[t], y[t]} =  Cos[t] ( 1  -  2 Cos[t]), 
        Sin[t] ( 1  -  2  Cos[t])}:

\(\(\(
\)\(Clear[x, y, t]

    {x[t_], y[t_]}\  = \ {Cos[t]\ \((\ 1\  - \ 2\ Cos[t])\), \ 
        Sin[t]\ \((\ 1\  - \ 2\ Cos[t])\)}

    \({tlow, thigh}\  = \ {0, \ 2\ Pi};\)

    \(ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
        PlotStyle -> {{Thickness[0.01], Red}}, 
        AxesLabel -> {"x", "y"}];\)\)\)\)

Here's what you get when you plot 
	{x[t], y[t]} = {Cos[t] (1 - Cos[t]^2), 
          Sin[t] (1 - Cos[t]^2)}:

\(\(\(
\)\(Clear[x, y, t]

    {x[t_], y[t_]}\  = \ {Cos[t]\ \((\ 1\  - \ Cos[t]^2)\), \ 
        Sin[t]\ \((\ 1\  - \ Cos[t]^2)\)}

    \({tlow, thigh}\  = \ {0, \ 2\ Pi};\)

    \(ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
        PlotStyle -> {{Thickness[0.01], Blue}}, 
        AxesLabel -> {"x", "y"}];\)\)\)\)

Here's what you get when you plot 
	{x[t], y[t]} = {Cos[t] (1 - 2  Cos[t]^2), 
          Sin[t] (1 - 2  Cos[t]^2)}:

\(\(\(
\)\(Clear[x, y, t]

    {x[t_], y[t_]}\  = \ {Cos[t]\ \((\ 1\  - \ 2\ Cos[t]^2)\), \ 
        Sin[t]\ \((\ 1\  - 2\ Cos[t]^2)\)}

    \({tlow, thigh}\  = \ {0, \ 2\ Pi};\)

    \(ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
        PlotStyle -> {{Thickness[0.01], Red}}, 
        AxesLabel -> {"x", "y"}];\)\)\)\)

Here's what you get when you plot 
	{x[t], y[t]} = {Cos[t] (1 - 2  Cos[t]^2),  
              Sin[t] ( 1  -  2 Cos[t]))}:

\(\(\(
\)\(Clear[x, y, t]

    {x[t_], y[t_]}\  = \ {Cos[t]\ \((\ 1\  - \ 2\ Cos[t]^2)\), \ 
        Sin[t]\ \((\ 1\  - 2\ Cos[t])\)}

    \({tlow, thigh}\  = \ {0, \ 2\ Pi};\)

    \(ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
        PlotStyle -> {{Thickness[0.01], Cobalt}}, 
        AxesLabel -> {"x", "y"}];\)\)\)\)

Here's what you get when you plot 
	{x[t], y[t]} = {Cos[t] (1 - 2  Cos[t]^2),  
              Sin[t] ( 1  -  2 Cos[2  t]))}:

\(\(\(
\)\(Clear[x, y, t]

    {x[t_], y[t_]}\  = \ {Cos[t]\ \((\ 1\  - \ 2\ Cos[t]^2)\), \ 
        Sin[t]\ \((\ 1\  - 2\ Cos[2\ t])\)}

    \({tlow, thigh}\  = \ {0, \ 2\ Pi};\)

    \(ParametricPlot[{x[t], y[t]}, {t, tlow, thigh}, 
        PlotStyle -> {{Thickness[0.01], Red}}, 
        AxesLabel -> {"x", "y"}];\)\)\)\)

Play